home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / elaborate / misc.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  1.9 KB  |  66 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. (* misc.sml *)
  3.  
  4. structure Misc : MISC =
  5. struct
  6.  
  7.   open Variables Modules Types
  8.   open ErrorMsg Symbol PrintUtil Access BasicTypes
  9.        TypesUtil Absyn 
  10.  
  11.   val ASTERISKsym = Symbol.varSymbol "*"
  12.   val EQUALsym = Symbol.varSymbol "="
  13.  
  14.   fun for l f = app f l
  15.  
  16.   local fun uniq ((a0 as (a,_,_))::(r as (b,_,_)::_)) = 
  17.             if Symbol.eq(a,b) then uniq r else a0::uniq r
  18.       | uniq l = l
  19.       fun gtr((a,_,_),(b,_,_)) = 
  20.              let val a' = Symbol.name a and b' = Symbol.name b
  21.                  val zero = ord "0" and nine = ord "9"
  22.              val a0 = ordof(a',0) and b0 = ordof(b',0)
  23.               in if a0 >= zero andalso a0 <= nine
  24.               then if b0 >= zero andalso b0 <= nine
  25.                  then size a' > size b' orelse
  26.                       size a' = size b' andalso a' > b'
  27.                  else false
  28.               else if b0 >= zero andalso b0 <= nine
  29.                 then true
  30.                 else a' > b'
  31.              end
  32.    in val sort3 = uniq o Sort.sort gtr
  33.   end
  34.  
  35.   (* following could go in Absyn *)
  36.   val bogusID = Symbol.varSymbol "*bogus*"
  37.   val bogusExnID = Symbol.varSymbol "*Bogus*"
  38.   val bogusExp = VARexp(ref(VALvar{name=[bogusID],typ=ref WILDCARDty,
  39.                        access=PATH[0]}),NONE)
  40.  
  41.   val anonParamName = Symbol.strSymbol "<AnonParam>"
  42.   fun discard _ = ()
  43.  
  44.   fun single x = [x]
  45.  
  46.   fun varcon (VARbind v) = VARexp(ref v,NONE)
  47.     | varcon (CONbind d) = CONexp(d, NONE)
  48.     | varcon _ = impossible "Misc.varcon"
  49.  
  50.   fun checkbound(used,bound,err) =
  51.     let open TyvarSet
  52.     val boundset = fold (fn (v,s) =>
  53.                 union_tyvars(singleton_tyvar v,s,err))
  54.                     bound no_tyvars
  55.     fun nasty(ref(INSTANTIATED(VARty v))) = nasty v
  56.       | nasty(ubound as ref(OPEN{kind=UBOUND _,...})) = 
  57.          err COMPLAIN ("unbound type variable in type declaration: " ^
  58.                (PPType.tyvar_printname ubound))
  59.              nullErrorBody
  60.       | nasty _ = impossible "Misc.checkbound"
  61.      in
  62.     app nasty (get_tyvars(diff_tyvars(used, boundset, err)))
  63.     end
  64.  
  65. end (* structure Misc *)
  66.